home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / WinAPI Cla185664192001.psc / WinApi.Cls < prev   
Encoding:
Visual Basic class definition  |  2001-04-20  |  45.9 KB  |  1,087 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CWinAPI"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. Dim Akhil As Long
  17.  
  18. 'VolumeLabel
  19. Private Declare Function GetVolumeInformation Lib "kernel32" _
  20. Alias "GetVolumeInformationA" _
  21. (ByVal lpRootPathName As String, _
  22. ByVal lpVolumeNameBuffer As String, _
  23. ByVal nVolumeNameSize As Long, _
  24. lpVolumeSerialNumber As Long, _
  25. lpMaximumComponentLength As Long, _
  26. lpFileSystemFlags As Long, _
  27. ByVal lpFileSystemNameBuffer As String, _
  28. ByVal nFileSystemNameSize As Long) As Long
  29.  
  30. 'DiskFreeSpace
  31. Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long
  32.  
  33. 'FindFiles
  34. Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
  35. Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
  36. Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
  37. Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
  38. Private Const MAX_PATH = 260, MAXDWORD = &HFFFF, INVALID_HANDLE_VALUE = -1, FILE_ATTRIBUTE_ARCHIVE = &H20, FILE_ATTRIBUTE_DIRECTORY = &H10, FILE_ATTRIBUTE_HIDDEN = &H2, FILE_ATTRIBUTE_NORMAL = &H80, FILE_ATTRIBUTE_READONLY = &H1, FILE_ATTRIBUTE_SYSTEM = &H4, FILE_ATTRIBUTE_TEMPORARY = &H100
  39. Private Type FILETIME
  40.     dwLowDateTime As Long
  41.     dwHighDateTime As Long
  42. End Type
  43. Private Type WIN32_FIND_DATA
  44.     dwFileAttributes As Long:    ftCreationTime As FILETIME:    ftLastAccessTime As FILETIME:    ftLastWriteTime As FILETIME:    nFileSizeHigh As Long:    nFileSizeLow As Long:    dwReserved0 As Long:    dwReserved1 As Long:    cFileName As String * MAX_PATH:    cAlternate As String * 14
  45. End Type
  46. Private Declare Function SendMessageList Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
  47. Const LB_ADDSTRING = &H180
  48.  
  49. 'ComputerName
  50. Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
  51. Private Declare Function SetComputerName Lib "kernel32" Alias "SetComputerNameA" (ByVal lpComputerName As String) As Long
  52. Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
  53.  
  54. Private Const REG_NONE = 0&: Private Const REG_SZ = 1&: Private Const REG_EXPAND_SZ = 2&
  55. Private Const REG_BINARY = 3&: Private Const REG_DWORD = 4&: Private Const REG_DWORD_LITTLE_ENDIAN = 4&: Private Const REG_DWORD_BIG_ENDIAN = 5&: Private Const REG_LINK = 6&: Private Const REG_MULTI_SZ = 7&: Private Const REG_RESOURCE_LIST = 8&: Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9&: Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10&
  56.  
  57. Private Const HKEY_CLASSES_ROOT = &H80000000
  58. Private Const HKEY_CURRENT_USER = &H80000001
  59. Private Const HKEY_LOCAL_MACHINE = &H80000002
  60. Private Const HKEY_USERS = &H80000003
  61. Private Const HKEY_PERFORMANCE_DATA = &H80000004
  62. Private Const HKEY_CURRENT_CONFIG = &H80000005
  63. Private Const HKEY_DYN_DATA = &H80000006
  64.  
  65. Private Const ERROR_NONE = 0
  66. Private Const ERROR_BADDB = 1
  67. Private Const ERROR_BADKEY = 2
  68. Private Const ERROR_CANTOPEN = 3
  69. Private Const ERROR_CANTREAD = 4
  70. Private Const ERROR_CANTWRITE = 5
  71. Private Const ERROR_OUTOFMEMORY = 6
  72. Private Const ERROR_INVALID_PARAMETER = 7
  73. Private Const ERROR_ACCESS_DENIED = 8
  74. Private Const ERROR_INVALID_PARAMETERS = 87
  75. Private Const ERROR_NO_MORE_ITEMS = 259
  76.  
  77. Private Const KEY_QUERY_VALUE = &H1&
  78. Private Const KEY_SET_VALUE = &H2&
  79. Private Const KEY_CREATE_SUB_KEY = &H4&
  80. Private Const KEY_ENUMERATE_SUB_KEYS = &H8&
  81. Private Const KEY_NOTIFY = &H10&
  82. Private Const KEY_CREATE_LINK = &H20&
  83. Private Const READ_CONTROL = &H20000
  84. Private Const WRITE_DAC = &H40000
  85. Private Const WRITE_OWNER = &H80000
  86. Private Const SYNCHRONIZE = &H100000
  87. Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
  88. Private Const STANDARD_RIGHTS_READ = READ_CONTROL
  89. Private Const STANDARD_RIGHTS_WRITE = READ_CONTROL
  90. Private Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
  91. Private Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
  92. Private Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
  93. Private Const KEY_EXECUTE = KEY_READ
  94.  
  95. Private Declare Function RegEnumKeyEx& Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey&, ByVal dwIndex&, ByVal lpname$, lpcbName&, ByVal lpReserved&, ByVal lpClass$, lpcbClass&, lpftLastWriteTime As FILETIME)
  96. Private Declare Function RegEnumValue& Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey&, ByVal dwIndex&, ByVal lpname$, lpcbName&, ByVal lpReserved&, lpdwType&, lpValue As Any, lpcbValue&)
  97. Private Declare Function RegQueryInfoKey& Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey&, ByVal lpClass$, lpcbClass&, ByVal lpReserved&, lpcSubKeys&, lpcbMaxSubKeyLen&, lpcbMaxClassLen&, lpcValues&, lpcbMaxValueNameLen&, lpcbMaxValueLen&, lpcbSecurityDescriptor&, lpftLastWriteTime As FILETIME)
  98. Private Const KEY_ALL_ACCESS = &H3: Private Const REG_OPTION_NON_VOLATILE = 0
  99.  
  100. Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  101. Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
  102. Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
  103. Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
  104. Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
  105. Private Declare Function RegSetValueExBinary Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Byte, ByVal cbData As Long) As Long
  106. Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
  107. Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
  108. Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
  109. Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
  110.  
  111. 'SystemParametersInfo
  112. Private Declare Function SystemParametersInfo Lib "User32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
  113. Private Const SPIF_UPDATEINIFILE = &H1, SPIF_SENDWININICHANGE = &H2
  114. Private Type RECT
  115.         Left As Long: Top As Long: Right As Long: Bottom As Long
  116. End Type
  117. Dim AkhilSt As RECT
  118.  
  119. 'ScreenSaver
  120. Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  121.     Const WM_SYSCOMMAND = &H112&, SC_SCREENSAVE = &HF140&
  122.  
  123. 'GetMousePos
  124. Private Type POINTAPI
  125.         x As Long: Y As Long
  126. End Type: Private AkhilApi As POINTAPI
  127. Private Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
  128.  
  129. 'Transparent form
  130. Private Const GWL_EXSTYLE = (-20), WS_EX_TRANSPARENT = &H20&, SWP_FRAMECHANGED = &H20, SWP_NOMOVE = &H2, SWP_NOSIZE = &H1, SWP_SHOWME = SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE, HWND_NOTOPMOST = -2, HWND_TOPMOST = -1
  131. Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  132. Private Declare Function SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  133.  
  134. 'ShellNotifyIcon
  135. Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
  136.  Private Type NOTIFYICONDATA
  137.     cbSize As Long:    hWnd As Long:    uID As Long:    uFlags As Long:    uCallbackMessage As Long:    hIcon As Long:    szTip As String * 64
  138. End Type
  139. Const NIM_ADD = &H0, NIM_MODIFY = &H1, NIM_DELETE = &H2, NIF_MESSAGE = &H1, NIF_ICON = &H2, NIF_TIP = &H4
  140. Const NIF_DOALL = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
  141. Const WM_MOUSEMOVE = &H200, WM_LBUTTONDBLCLK = &H203, WM_LBUTTONDOWN = &H201, WM_RBUTTONDOWN = &H204
  142.  
  143. 'MenuBitmaps
  144. Private Declare Function GetMenu Lib "User32" (ByVal hWnd As Long) As Long
  145. Private Declare Function GetSubMenu Lib "User32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
  146. Private Declare Function GetMenuItemID Lib "User32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
  147. Private Declare Function SetMenuItemBitmaps Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
  148. Private Const MF_BITMAP = &H4&
  149.  
  150. 'MoveFormWithoutBorders
  151. Private Declare Function SendMessageMFWB Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  152. Private Declare Sub ReleaseCapture Lib "User32" ()
  153. Const WM_NCLBUTTONDOWN = &HA1, HTCAPTION = 2
  154.  
  155. 'GetSystemFolders
  156. Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  157. Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nSize As Long, ByVal lpBuffer As String) As Long
  158. Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  159.  
  160. 'Keybd_event
  161. Private Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
  162. Private Const VK_LWIN = &H5B, KEYEVENTF_KEYUP = &H2, VK_APPS = &H5D
  163.  
  164. 'PlayAVI
  165. Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
  166.  
  167. 'SetDeskWallPaper
  168. Private Declare Function SystemParameters Lib "User32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
  169.  
  170. 'ExitWindows
  171. Private Declare Function ExitWindowsEx Lib "User32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
  172. Const EWX_FORCE = 4, EWX_LOGOFF = 0, EWX_REBOOT = 2, EWX_SHUTDOWN = 1
  173.  
  174. 'ShowHideTaskBar
  175. Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  176. Const SWP_HIDEWINDOW = &H80, SWP_SHOWWINDOW = &H40
  177.  
  178. 'Retrieve Icon
  179. Private Const SHGFI_DISPLAYNAME = &H200, SHGFI_EXETYPE = &H2000, SHGFI_SYSICONINDEX = &H4000, SHGFI_LARGEICON = &H0, SHGFI_SMALLICON = &H1, SHGFI_SHELLICONSIZE = &H4, SHGFI_TYPENAME = &H400, ILD_TRANSPARENT = &H1, BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE
  180. Private Type SHFILEINFO
  181.    hIcon As Long: iIcon As Long: dwAttributes As Long: szDisplayName As String * MAX_PATH: szTypeName As String * 80
  182. End Type
  183. Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbSizeFileInfo As Long, ByVal uFlags As Long) As Long
  184. Private Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal hDCDest As Long, ByVal x As Long, ByVal Y As Long, ByVal flags As Long) As Long
  185. Private shinfo As SHFILEINFO, sshinfo As SHFILEINFO
  186.  
  187. 'DocumentList
  188. Private Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, ByVal pv As String)
  189.  
  190. 'Hotkey
  191. Private Declare Function SendMessageHotKey Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
  192. Private Declare Function DefWindowProc Lib "User32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  193. Private Const WM_SETHOTKEY = &H32, WM_SHOWWINDOW = &H18
  194.  
  195. 'ShowCursor
  196. Private Declare Function ShowCursor& Lib "User32" (ByVal bShow As Long)
  197.  
  198. 'Detect Sound Card
  199. Private Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
  200.  
  201. 'ShellExecute
  202. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  203. Private Const SW_SHOWNORMAL As Long = 1, SW_SHOWMAXIMIZED As Long = 3, SW_SHOWDEFAULT As Long = 10
  204.  
  205. 'sndPlaySound
  206. Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
  207. Private Const SND_ALIAS = &H10000, SND_ASYNC = &H1, SND_NOWAIT = &H2000, SND_LOOP = &H8
  208.  
  209. 'SetCursorPos
  210. Private Declare Function SetCursorPos Lib "User32" (ByVal x As Long, ByVal Y As Long) As Long
  211.  
  212. 'Change ToolBar Style
  213. Private Const WM_USER = &H400, TB_SETSTYLE = WM_USER + 56, TB_GETSTYLE = WM_USER + 57, TBSTYLE_FLAT = &H800
  214. Private Declare Function SendMessageLong Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  215. Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
  216.  
  217. 'Default Property Values:
  218. Const m_def_x = 0, m_def_y = 0, m_def_WorkAreaLeft = 0, m_def_WorkAreaTop = 0, m_def_WorkAreaRight = 0, m_def_WorkAreaBottom = 0
  219.  
  220. 'Property Variables:
  221. Dim m_WorkAreaLeft, m_WorkAreaTop, m_WorkAreaRight, m_WorkAreaBottom, m_x, m_y As Integer
  222.  
  223. Public Enum ShowCursors
  224. chtHide = False
  225. chtShow = True
  226. End Enum
  227. Public Enum Hotkeys
  228. keyShiftA = &H141
  229. keyShiftB = &H142
  230. keyShiftC = &H143
  231. keyShiftD = &H144
  232. keyShiftE = &H145
  233. keyShiftF = &H146
  234. keyShiftG = &H147
  235. keyShiftH = &H148
  236. keyShiftI = &H149
  237. keyShiftJ = &H14A
  238. keyShiftK = &H14B
  239. keyShiftL = &H14C
  240. keyShiftM = &H14D
  241. keyShiftN = &H14E
  242. keyShiftO = &H14F
  243. keyShiftP = &H150
  244. keyShiftQ = &H151
  245. keyShiftR = &H152
  246. keyShiftS = &H153
  247. keyShiftT = &H154
  248. keyShiftU = &H155
  249. keyShiftV = &H156
  250. keyShiftW = &H157
  251. keyShiftX = &H158
  252. keyShiftY = &H159
  253. keyShiftZ = &H15A
  254.  
  255. keyControlA = &H241
  256. keyControlB = &H242
  257. keyControlC = &H243
  258. keyControlD = &H244
  259. keyControlE = &H245
  260. keyControlF = &H246
  261. keyControlG = &H247
  262. keyControlH = &H248
  263. keyControlI = &H249
  264. keyControlJ = &H24A
  265. keyControlK = &H24B
  266. keyControlL = &H24C
  267. keyControlM = &H24D
  268. keyControlN = &H24E
  269. keyControlO = &H24F
  270. keyControlP = &H250
  271. keyControlQ = &H251
  272. keyControlR = &H252
  273. keyControlS = &H253
  274. keyControlT = &H254
  275. keyControlU = &H255
  276. keyControlV = &H256
  277. keyControlW = &H257
  278. keyControlX = &H258
  279. keyControlY = &H259
  280. keyControlZ = &H25A
  281.  
  282. keyAltA = &H441
  283. keyAltB = &H442
  284. keyAltC = &H443
  285. keyAltD = &H444
  286. keyAltE = &H445
  287. keyAltF = &H446
  288. keyAltG = &H447
  289. keyAltH = &H448
  290. keyAltI = &H449
  291. keyAltJ = &H44A
  292. keyAltK = &H44B
  293. keyAltL = &H44C
  294. keyAltM = &H44D
  295. keyAltN = &H44E
  296. keyAltO = &H44F
  297. keyAltP = &H450
  298. keyAltQ = &H451
  299. keyAltR = &H452
  300. keyAltS = &H453
  301. keyAltT = &H454
  302. keyAltU = &H455
  303. keyAltV = &H456
  304. keyAltW = &H457
  305. keyAltX = &H458
  306. keyAltY = &H459
  307. keyAltZ = &H45A
  308. End Enum
  309. Public Enum PlaySoundSettings
  310.     sndWavFile = 0
  311.     sndWindowsStart = 1
  312.     sndWindowsExit = 2
  313.     sndRestoreUp = 3
  314.     sndRestoreDown = 4
  315.     sndApplicationError = 5
  316.     sndQuestion = 6
  317.     sndAsterisk = 7
  318.     sndExclamation = 8
  319.     sndSystemHand = 9
  320. End Enum
  321. Public Enum TrayIconReturnValues
  322.     xyzMouseMove = &H200
  323.     xyzLeftButtonDown = &H201
  324.     xyzLeftButtonUp = &H202
  325.     xyzLeftButtonDoubleClick = &H203
  326.     xyzRightButtonDown = &H204
  327.     xyzRightButtonUp = &H205
  328.     xyzRightButtonDoubleClick = &H206
  329.     xyzMiddleButtonDown = &H207
  330.     xyzMiddleButtonUp = &H208
  331.     xyzMiddleButtonDoubleClick = &H209
  332. End Enum
  333. Public Enum SystemDirs
  334.     dirWindows = 0
  335.     dirSystem = 1
  336.     dirTemp = 2
  337. End Enum
  338. Public Enum StartMenuItems
  339.     strtExplorer
  340.     strtFind
  341.     strtMinimize
  342.     strtRun
  343.     strtStartMenu
  344.     strtHelp
  345. End Enum
  346. Public Enum IconRetrieve
  347. ricnLarge = 32
  348. ricnSmall = 16
  349. End Enum
  350. Public Enum Reg
  351.     CLASSES_ROOT = &H80000000
  352.     CURRENT_USER = &H80000001
  353.     LOCAL_MACHINE = &H80000002
  354.     USERS = &H80000003
  355.     PERFORMANCE_DATA = &H80000004
  356.     CURRENT_CONFIG = &H80000005
  357.     DYN_DATA = &H80000006
  358. End Enum
  359. Public Enum RegDataType
  360.     regString = 1
  361.     regBinary = 3
  362.     regDword = 4
  363. End Enum
  364. Public Enum ShellIcon
  365.     shelliconAdd = 0
  366.     shelliconModify = 1
  367.     shelliconDelete = 2
  368. End Enum
  369. Public Enum ComputerNames
  370.     cmpGetComputerName = 0
  371.     cmpSetComputerName = 1
  372.     cmpGetUserName = 2
  373. End Enum
  374. Enum WindowsShutDown
  375.     winShutDown = 0
  376.     winReboot = 1
  377.     winForce = 2
  378.     winLogOff = 3
  379. End Enum
  380. Public Enum AutoRunDrives
  381.     runFloppy = 251
  382.     runHard = 247
  383.     runFloppyHard = 243
  384.     runDataCD = 223
  385.     runAudioCD = 255
  386.     runAudioDataCD = 223
  387.     runAllDrives = 131
  388.     runRAMDrive = 191
  389.     runNetworkDrive = 239
  390.     runNetworkRAMDrives = 175
  391. End Enum
  392. Public Sub PlaySound(func As PlaySoundSettings, Optional WavFileName As String)
  393. Dim temp As String: Select Case func
  394. Case 0:        Akhil = sndPlaySound(WavFileName, SND_ASYNC + SND_NOWAIT)
  395. Case 1:        temp = "SystemStart":        GoTo PlayAlias
  396. Case 2:        temp = "SystemExit":        GoTo PlayAlias
  397. Case 3:        temp = "RestoreUp":        GoTo PlayAlias
  398. Case 4:        temp = "RestoreDown":        GoTo PlayAlias
  399. Case 5:        temp = "AppGPFault":        GoTo PlayAlias
  400. Case 6:        temp = "SystemQuestion":        GoTo PlayAlias
  401. Case 7:        temp = "SystemAsterisk":        GoTo PlayAlias
  402. Case 8:        temp = "SystemExclamation":        GoTo PlayAlias
  403. Case 9:        temp = "SystemHand":        GoTo PlayAlias: End Select: Exit Sub
  404. PlayAlias: Akhil = sndPlaySound(temp, SND_ALIAS + SND_ASYNC + SND_NOWAIT)
  405. End Sub
  406. Public Sub SetMyPosTopMost(h As Long, Optional TakeOffMyPosTopMost As Boolean)
  407. If TakeOffMyPosTopMost = True Then
  408. SetWindowPos h, -2, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
  409. Else
  410. SetWindowPos h, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
  411. End If
  412. End Sub
  413. Public Sub SetMyPosOnDesktop(h As Long)
  414. SetWindowPos h, 1, 0&, 0&, 0&, 0&, &H1 Or &H2 Or &H10
  415. End Sub
  416. Public Sub HideWindow(h As Long, Optional ShowMe As Boolean)
  417. If ShowMe = False Then
  418. SetWindowPos h, 1, 0&, 0&, 0&, 0&, SWP_HIDEWINDOW
  419. Else
  420. SetWindowPos h, 1, 0&, 0&, 0&, 0&, SWP_SHOWWINDOW
  421. End If
  422. End Sub
  423. Public Sub SetSysWorkArea(l As Integer, t As Integer, r As Integer, b As Integer)
  424. AkhilSt.Left = l
  425. AkhilSt.Top = t
  426. AkhilSt.Right = r
  427. AkhilSt.Bottom = b
  428. Akhil = SystemParametersInfo(47, 0, AkhilSt, SPIF_SENDWININICHANGE Or SPIF_UPDATEINIFILE)
  429. End Sub
  430. Public Sub ChangeToolBarStyle(ToolBarh As Long)
  431. 'Refresh after using the function to get the results. eg: Toolbar1.Refresh
  432.  Dim style As Long, hToolbar As Long, r As Long
  433.  hToolbar = FindWindowEx(ToolBarh, 0&, "ToolbarWindow32", vbNullString)
  434.  style = SendMessageLong(hToolbar, TB_GETSTYLE, 0&, 0&)
  435.  style = style Or TBSTYLE_FLAT
  436.  Call SendMessageLong(hToolbar, TB_SETSTYLE, 0, style)
  437.  End Sub
  438. Public Sub MakeTransparentForm(h As Long)
  439. SetWindowLong h, GWL_EXSTYLE, WS_EX_TRANSPARENT
  440. SetWindowPos h, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, SWP_SHOWME
  441. End Sub
  442. Public Function GetSystemFolders(func As SystemDirs)
  443. Dim r, nSize As Long, tmp As String
  444.  tmp = Space$(256):    nSize = Len(tmp)
  445. Select Case func
  446.    Case 0
  447.       r = GetWindowsDirectory(tmp, nSize):     GetSystemFolders = TrimNull(tmp)
  448.     Case 1
  449.       r = GetSystemDirectory(tmp, nSize):      GetSystemFolders = TrimNull(tmp)
  450.     Case 2
  451.        r = GetTempPath(nSize, tmp):       GetSystemFolders = TrimNull(tmp)
  452.     End Select
  453. End Function
  454. Public Sub TrayIcon(func As ShellIcon, h As Long, sName As String, p As StdPicture)
  455. Dim Tic As NOTIFYICONDATA
  456. Tic.cbSize = Len(Tic): Tic.hWnd = h: Tic.uID = 1&: Tic.uFlags = NIF_DOALL
  457. Tic.uCallbackMessage = WM_MOUSEMOVE: Tic.hIcon = p: Tic.szTip = sName & Chr$(0)
  458. Select Case func
  459. Case 0
  460. erg = Shell_NotifyIcon(NIM_ADD, Tic)
  461. Case 1
  462. erg = Shell_NotifyIcon(NIM_MODIFY, Tic)
  463. Case 2
  464. erg = Shell_NotifyIcon(NIM_DELETE, Tic)
  465. End Select
  466. End Sub
  467. Public Function TryIcnRtnMsg(x As Single) As TrayIconReturnValues
  468. x = x \ Screen.TwipsPerPixelX
  469. Select Case x
  470.     Case xyzMouseMove: TryIcnRtnMsg = &H200
  471.     Case xyzLeftButtonDown: TryIcnRtnMsg = &H201
  472.     Case xyzLeftButtonUp: TryIcnRtnMsg = &H202
  473.     Case xyzLeftButtonDoubleClick: TryIcnRtnMsg = &H203
  474.     Case xyzRightButtonDown: TryIcnRtnMsg = &H204
  475.     Case xyzRightButtonUp: TryIcnRtnMsg = &H205
  476.     Case xyzRightButtonDoubleClick: TryIcnRtnMsg = &H206
  477.     Case xyzMiddleButtonDown: TryIcnRtnMsg = &H207
  478.     Case xyzMiddleButtonUp: TryIcnRtnMsg = &H208
  479.     Case xyzMiddleButtonDoubleClick: TryIcnRtnMsg = &H209
  480. End Select
  481. End Function
  482. Public Sub MenuBitmaps(h As Long, subMenu As Byte, MenuID As Byte, chkbmp As StdPicture)
  483. hMenu& = GetMenu(h)
  484. hSubMenu& = GetSubMenu(hMenu&, subMenu)
  485. hID& = GetMenuItemID(hSubMenu&, MenuID)
  486. SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, chkbmp, chkbmp
  487. End Sub
  488. Public Sub MoveFormWithoutBorders(h As Long)
  489. Dim lngReturnValue As Long
  490. Call ReleaseCapture
  491. lngReturnValue = SendMessageMFWB(h, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
  492. End Sub
  493. Public Sub Launch(func As StartMenuItems)
  494. Dim VK_ACTION As Long
  495. Select Case func
  496.       Case strtExplorer: VK_ACTION = &H45
  497.       Case strtFind: VK_ACTION = &H46
  498.       Case strtMinimize: VK_ACTION = &H4D
  499.       Case strtRun: VK_ACTION = &H52
  500.       Case strtStartMenu: VK_ACTION = &H5B
  501.       Case strtHelp: VK_ACTION = &H70
  502. End Select
  503.    Call keybd_event(VK_LWIN, 0, 0, 0):   Call keybd_event(VK_ACTION, 0, 0, 0)
  504.    Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)
  505. End Sub
  506. 'Public Sub DocumentList(func As Byte, Optional sName As String)
  507. 'Select Case func
  508. 'Case 0
  509. 'If sName <> "" Then Call SHAddToRecentDocs(2, sName)
  510. 'Case 1
  511. 'Call SHAddToRecentDocs(2, vbNullString)
  512. 'End Select
  513. 'End Sub
  514. Public Sub SetDeskWallPaper(func As Byte, Optional sBitmapFile As String)
  515. Dim lRetVal As Long
  516. Select Case func
  517. Case 1
  518. lRetVal = SystemParameters(ByVal 20, 0&, ByVal sBitmapFile, _
  519. SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
  520. Case 0
  521. lRetVal = SystemParameters(20, 0&, "(None)", _
  522. SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
  523. End Select
  524. End Sub
  525. Public Sub ExitWindows(func As WindowsShutDown)
  526. Dim lRetVal As Long
  527. Select Case func
  528. Case 0
  529. lRetVal = ExitWindowsEx(EWX_SHUTDOWN, 0)
  530. Case 1
  531. lRetVal = ExitWindowsEx(EWX_REBOOT, 0)
  532. Case 2
  533. lRetVal = ExitWindowsEx(EWX_FORCE, 0)
  534. Case 3
  535. lRetVal = ExitWindowsEx(EWX_LOGOFF, 0)
  536. End Select
  537. End Sub
  538. Public Sub RetrieveIcon(fName As String, DC As Long, icnSize As IconRetrieve)
  539. Dim hImgSmall, hImgLarge As Long  'the handle to the system image list
  540. Select Case icnSize
  541. Case ricnSmall
  542. hImgSmall = SHGetFileInfo(fName$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
  543. Call ImageList_Draw(hImgSmall, shinfo.iIcon, DC, 0, 0, ILD_TRANSPARENT)
  544. Case ricnLarge
  545. hImgLarge& = SHGetFileInfo(fName$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)
  546. Call ImageList_Draw(hImgLarge, shinfo.iIcon, DC, 0, 0, ILD_TRANSPARENT)
  547. End Select
  548. End Sub
  549. Public Function RetrieveFileTypeName(fName As String) As String
  550. ImgSmall& = SHGetFileInfo(fName$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
  551. RetrieveFileTypeName = Left$(shinfo.szTypeName, InStr(shinfo.szTypeName, Chr$(0)) - 1)
  552. End Function
  553. Public Sub TaskBar(func As Byte)
  554. Dim Thwnd As Long
  555. Select Case func
  556. Case 0
  557. Thwnd = FindWindow("Shell_traywnd", "")
  558. Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
  559. Case 1
  560.  Thwnd = FindWindow("Shell_traywnd", "")
  561. Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
  562. End Select
  563. End Sub
  564. Public Sub ShowMouse(cur As ShowCursors)
  565. Select Case cur
  566.     Case chtHide
  567.         Call ShowCursor(False)
  568.      Case chtShow
  569.         Call ShowCursor(True)
  570. End Select
  571. End Sub
  572. Public Sub StartScreenSaver(handle As Long)
  573. Dim result As Long
  574. result = SendMessage(handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
  575. End Sub
  576. Public Sub SetHotKey(h As Long, key As Hotkeys)
  577. erg& = SendMessageHotKey(h, WM_SETHOTKEY, key, 0)
  578. If erg& <> 1 Then
  579. MsgBox "You need another hotkey", vbOKOnly, "Error"
  580. End If
  581. erg& = DefWindowProc(h, WM_SHOWWINDOW, 0, 0)
  582. End Sub
  583. Public Function SoundCardDetect() As Boolean
  584. Dim i As Integer
  585. i = waveOutGetNumDevs()
  586. If i > 0 Then
  587.     SoundCardDetect = True
  588. Else
  589.     SoundCardDetect = False
  590. End If
  591. End Function
  592. Public Sub Delay(HowLong As Date)
  593. TempTime = DateAdd("s", HowLong, Now)
  594. While TempTime > Now
  595. DoEvents 'Allows windows to handle other stuff
  596. Wend
  597. End Sub
  598. Public Sub DocumentList(func As String, Optional sName As String)
  599. func = UCase$(func)
  600. Select Case func
  601.     Case "CLEAR"
  602.      Call SHAddToRecentDocs(2, vbNullString)
  603.     Case "ADD"
  604.     Call SHAddToRecentDocs(2, sName)
  605. End Select
  606. End Sub
  607. Public Sub PlayAvi(sFile As String)
  608. Dim returnstring As String
  609. returnstring = Space(127)
  610. erg = mciSendString("open " & Chr$(34) & sFile & Chr$(34) & " type avivideo alias video", returnstring, 127, 0)
  611. erg = mciSendString("set video time format ms", returnstring, 127, 0)
  612. erg = mciSendString("play video from 0", returnstring, 127, 0)
  613. End Sub
  614. Public Sub ShowRecycleBin(h As Long)
  615.    Dim success As Long
  616.    success = ShellExecute(h, "Open", "explorer.exe", "/root,::{645FF040-5081-101B-9F08-00AA002F954E}", 0&, SW_SHOWNORMAL)
  617. End Sub
  618. Public Sub OpenWebSite(sFile As String, handle As Long)
  619.    Dim success As Long
  620.    success = ShellExecute(handle, "Open", sFile, 0&, 0&, 3)
  621.    If success < 32 Then
  622.      Call Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " & sFile, vbNormalFocus)
  623.   End If
  624. End Sub
  625. Public Sub ExecuteFile(sFile As String, handle As Long, Optional sParams As String)
  626.    Dim success As Long
  627.    success = ShellExecute(handle, "Open", sFile, sParams, 0&, 3)
  628.    If success < 32 Then
  629.      Call Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " & sFile, vbNormalFocus)
  630.   End If
  631. End Sub
  632.  
  633. Public Sub SendEmail(address As String, handle As Long)
  634.    address = "mailto:" & address
  635.    Dim success As Long
  636.    success = ShellExecute(handle, "Open", address, 0&, 0&, 3)
  637.  End Sub
  638. Public Function PtoT(no As Variant, Optional YValue As Boolean)
  639. ' This function converts Pixels to Twips
  640. If Not YValue Then
  641. PtoT = no * Screen.TwipsPerPixelX
  642. Else
  643. PtoT = no * Screen.TwipsPerPixelY
  644. End If
  645. End Function
  646. Public Function TtoP(no As Variant, Optional YValue As Boolean)
  647. ' This function does the reverse of the above function
  648. If Not YValue Then
  649. TtoP = no \ Screen.TwipsPerPixelX
  650. Else
  651. TtoP = no \ Screen.TwipsPerPixelY
  652. End If
  653. End Function
  654. Public Sub SetMousePos(xx As Long, yy As Long)
  655. Call SetCursorPos(xx, yy)
  656. End Sub
  657. Public Property Get WorkAreaLeft() As Integer
  658.     Class_Initialize
  659.     WorkAreaLeft = m_WorkAreaLeft
  660. End Property
  661. Public Property Get WorkAreaTop() As Integer
  662.     Class_Initialize
  663.     WorkAreaTop = m_WorkAreaTop
  664. End Property
  665. Public Property Get WorkAreaRight() As Integer
  666.     Class_Initialize
  667.     WorkAreaRight = m_WorkAreaRight
  668. End Property
  669. Public Property Get MouseX() As Integer
  670.     Class_Initialize
  671.     MouseX = m_x
  672. End Property
  673. Public Property Get MouseY() As Integer
  674.     Class_Initialize
  675.     MouseY = m_y
  676. End Property
  677. Public Property Get WorkAreaBottom() As Integer
  678.         Class_Initialize
  679.         WorkAreaBottom = m_WorkAreaBottom
  680. End Property
  681.  
  682. Private Sub Class_Initialize()
  683.     m_WorkAreaLeft = m_def_WorkAreaLeft
  684.     m_WorkAreaTop = m_def_WorkAreaTop
  685.     m_WorkAreaRight = m_def_WorkAreaRight
  686.     m_WorkAreaBottom = m_def_WorkAreaBottom
  687.     m_x = m_def_x
  688.     m_y = m_def_y
  689.     Akhil = SystemParametersInfo(48, 0, AkhilSt, SPIF_SENDWININICHANGE Or SPIF_UPDATEINIFILE)
  690.     m_WorkAreaLeft = AkhilSt.Left * Screen.TwipsPerPixelX
  691.     m_WorkAreaTop = AkhilSt.Top * Screen.TwipsPerPixelY
  692.     m_WorkAreaRight = AkhilSt.Right * Screen.TwipsPerPixelX
  693.     m_WorkAreaBottom = AkhilSt.Bottom * Screen.TwipsPerPixelY
  694.     GetCursorPos AkhilApi
  695.     m_x = AkhilApi.x * Screen.TwipsPerPixelX
  696.     m_y = AkhilApi.Y * Screen.TwipsPerPixelY
  697. End Sub
  698. Public Sub ListFunc()
  699. 'Temporary Function
  700. 'Lists all the functions of this WinApi Class
  701. Dim Msg As String
  702. Msg = Msg & vbNewLine & "Delay "
  703. Msg = Msg & vbNewLine & "DiskSpace "
  704. Msg = Msg & vbNewLine & "DocumentList "
  705. Msg = Msg & vbNewLine & "ExecuteFile "
  706. Msg = Msg & vbNewLine & "ExecuteFile "
  707. Msg = Msg & vbNewLine & "ExitWindows "
  708. Msg = Msg & vbNewLine & "FindFilesAPI "
  709. Msg = Msg & vbNewLine & "Launch "
  710. Msg = Msg & vbNewLine & "MakeTransparentForm "
  711. Msg = Msg & vbNewLine & "MenuBitmaps "
  712. Msg = Msg & vbNewLine & "MoveFormWithoutBorders "
  713. Msg = Msg & vbNewLine & "OpenWebSite "
  714. Msg = Msg & vbNewLine & "PlayAudioCD "
  715. Msg = Msg & vbNewLine & "PlayAvi "
  716. Msg = Msg & vbNewLine & "PlaySound "
  717. Msg = Msg & vbNewLine & "RegistryValueS "
  718. Msg = Msg & vbNewLine & "RegistryValueD "
  719. Msg = Msg & vbNewLine & "RegistryRun "
  720. Msg = Msg & vbNewLine & "RegistryDeleteValue "
  721. Msg = Msg & vbNewLine & "RegistryNewKey "
  722. Msg = Msg & vbNewLine & "RegistryDeleteKey "
  723. Msg = Msg & vbNewLine & "RegistryCreateRightClickAccess "
  724. Msg = Msg & vbNewLine & "RegistryCreateAssociation "
  725. Msg = Msg & vbNewLine & "RetrieveIcon "
  726. Msg = Msg & vbNewLine & "SendEmail "
  727. Msg = Msg & vbNewLine & "SetDeskWallPaper "
  728. Msg = Msg & vbNewLine & "SetHotKey "
  729. Msg = Msg & vbNewLine & "SetMousePos "
  730. Msg = Msg & vbNewLine & "SetMyPosOnDesktop "
  731. Msg = Msg & vbNewLine & "SetMyPosTopMost "
  732. Msg = Msg & vbNewLine & "SetSysWorkArea "
  733. Msg = Msg & vbNewLine & "ShowMouse "
  734. Msg = Msg & vbNewLine & "ShowRecycleBin "
  735. Msg = Msg & vbNewLine & "StartScreenSaver "
  736. Msg = Msg & vbNewLine & "TaskBar "
  737. Msg = Msg & vbNewLine & "TrayIcon "
  738. Msg = Msg & vbNewLine & "**********Functions**********"
  739. Msg = Msg & vbNewLine & "GetSystemFolders()"
  740. Msg = Msg & vbNewLine & "RetrieveFileTypeName()"
  741. Msg = Msg & vbNewLine & "SoundCardDetect()"
  742. Msg = Msg & vbNewLine & "TtoP()"
  743. Msg = Msg & vbNewLine & "PtoT()"
  744. Msg = Msg & vbNewLine & "**********Properties**********"
  745. Msg = Msg & vbNewLine & "WorkAreaLeft, WorkAreaRight, WorkAreaTop, WorkAreaBottom"
  746. Msg = Msg & vbNewLine & "MouseX, MouseY "
  747. MsgBox Msg
  748. End Sub
  749. Public Sub RegistryValueS(sKey As String, sValueName As String, sValue As String, home As Reg)
  750.    SetKeyValue sKey, sValueName, sValue, REG_SZ, home
  751. End Sub
  752. Public Sub RegistryValueD(sKey As String, sValueName As String, sValue As String, home As Reg)
  753.    SetKeyValue sKey, sValueName, sValue, REG_DWORD, home
  754. End Sub
  755. Public Sub RegistryValueB(sKey As String, sValueName As String, sValue As Byte, home As Reg)
  756.    SetKeyValue sKey, sValueName, sValue, REG_BINARY, home
  757. End Sub
  758. Public Function RegistryGetValue(sKey As String, sValueName As String, sValue As Variant, nValuetype As RegDataType, home As Reg)
  759. Call GetKeyValue(sKey, sValueName, sValue, nValuetype, home)
  760. If nValuetype = regString Then sValue = StripNulls(CStr(sValue))
  761. End Function
  762. Public Sub RegistryRun(sValueName As String, sValue As String)
  763.       SetKeyValue "software\microsoft\windows\currentversion\run", sValueName, sValue, REG_SZ, HKEY_LOCAL_MACHINE
  764. End Sub
  765. Public Sub RegistryDeleteValue(sKey As String, sValueName As String, home As Reg)
  766.       DeleteValue home, sKey, sValueName
  767. End Sub
  768. Public Sub RegistryNewKey(sKeyName As String, home As Reg)
  769.     CreateNewKey sKeyName, home
  770. End Sub
  771. Public Sub RegistryDeletekey(sSubKey As String, sKey As String, home As Reg)
  772.       DeleteKey home, sKey, sSubKey
  773. End Sub
  774. Public Sub RegistryCreateRightClickAccess(sName As String, sPath As String)
  775.    CreateNewKey "*\shell\" & sName & "\Command", HKEY_CLASSES_ROOT
  776.    If Right(App.path, 1) = "\" Then
  777.    sPath = App.path & App.EXEName & ".exe" & " " & Command & " " & "%1"
  778.    Else
  779.    sPath = App.path & "\" & App.EXEName & ".exe" & " " & Command & " " & "%1"
  780.    End If
  781.    SetKeyValue "*\shell\" & sName & "\Command", "", sPath, REG_SZ, HKEY_CLASSES_ROOT
  782. End Sub
  783. Public Sub RegistryCreateAssociation(sFileExtension_3Chars As String, _
  784.  sProgramType As String, sPath As String, Optional sProgramName As String)
  785.   CreateNewKey "." & sFileExtension_3Chars, HKEY_CLASSES_ROOT
  786.   Call SetKeyValue("." & sFileExtension_3Chars, "", sProgramType, REG_SZ, HKEY_CLASSES_ROOT)
  787.   CreateNewKey sProgramType & "\shell\open\command", HKEY_CLASSES_ROOT
  788.   SetKeyValue sProgramType, "", sProgramName, REG_SZ, HKEY_CLASSES_ROOT
  789.   sPath = sPath & " %1"
  790.   SetKeyValue sProgramType & "\shell\open\command", "", sPath, REG_SZ, HKEY_CLASSES_ROOT
  791. End Sub
  792. Public Sub RegistryEnumerateKeys(sValue As String, handleListbox As Long, home As Reg)
  793. Call RegEnumKeys(sValue, handleListbox, home)
  794. End Sub
  795. Public Sub RegistryEnumerateValues(sValue As String, handleListboxEntries As Long, handleListboxValues As Long, home As Reg)
  796. Call RegEnumValues(sValue, handleListboxEntries, handleListboxValues, home)
  797. End Sub
  798. Public Sub DisableCtrlAltDelete(bDisable As Boolean)
  799.     Dim x As Long
  800.     x = SystemParametersInfo(97, bDisable, CStr(1), 0)
  801. End Sub
  802. Public Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer, Optional handleListbox As Long, Optional SendBackInFilename_PathFormat As Boolean, Optional DontLookInSubFolders As Boolean)
  803. Dim Filename As String ' Walking filename variable...
  804. Dim DirName As String ' SubDirectory Name
  805. Dim i As Integer ' For-loop counter...
  806. Dim hSearch As Long ' Search Handle
  807. Dim WFD As WIN32_FIND_DATA
  808. Dim Cont As Integer
  809. Dim temp As String
  810. Dim dirNames() As String ' Buffer for directory name entries
  811. Dim nDir As Integer ' Number of directories in this path
  812. If Right(path, 1) <> "\" Then path = path & "\"
  813. If Not DontLookInSubFolders Then
  814. nDir = 0
  815. ReDim dirNames(nDir)
  816. Cont = True
  817. hSearch = FindFirstFile(path & "*", WFD)
  818. If hSearch <> INVALID_HANDLE_VALUE Then
  819.     Do While Cont
  820.     DirName = StripNulls(WFD.cFileName)
  821.     If (DirName <> ".") And (DirName <> "..") Then
  822.         If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
  823.             dirNames(nDir) = DirName
  824.             DirCount = DirCount + 1
  825.             nDir = nDir + 1
  826.             ReDim Preserve dirNames(nDir)
  827.         End If
  828.     End If
  829.     Cont = FindNextFile(hSearch, WFD)
  830.     DoEvents
  831.     Loop
  832.     Cont = FindClose(hSearch)
  833. End If
  834. End If
  835. hSearch = FindFirstFile(path & SearchStr, WFD)
  836. Cont = True
  837. If hSearch <> INVALID_HANDLE_VALUE Then
  838.     While Cont
  839.     Filename = StripNulls(WFD.cFileName)
  840.     DoEvents
  841.     If (Filename <> ".") And (Filename <> "..") Then
  842.         FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * _
  843.         MAXDWORD) + WFD.nFileSizeLow
  844.         FileCount = FileCount + 1
  845.         temp = path & Filename
  846.  If SendBackInFilename_PathFormat Then temp = Filename & vbTab & path
  847.  SendMessageList handleListbox, LB_ADDSTRING, -1, ByVal temp
  848.     End If
  849.     Cont = FindNextFile(hSearch, WFD) ' Get next file
  850.     Wend
  851.     Cont = FindClose(hSearch)
  852. End If
  853. If Not DontLookInSubFolders Then
  854. If nDir > 0 Then
  855.     For i = 0 To nDir - 1
  856.     DoEvents
  857.     Debug.Print path & dirNames(i) & "\"
  858.     If Not SendBackInFilename_PathFormat Then
  859.     FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount, handleListbox)
  860.     Else
  861.     FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount, handleListbox, True)
  862.     End If
  863.     Next i
  864. End If
  865. End If
  866. End Function
  867. Public Function DiskSpace(sPath As String, dFree As Double, dUsed As Double, dTotal As Double)
  868.  Dim sDrive As String
  869.  Dim lReturn As Long
  870.  Dim l1 As Long   'l1 = Sectors Per Cluster
  871.  Dim l2 As Long   'l2 = Bytes Per Sector
  872.  Dim l3 As Long   'l3 = Number Of Free Clusters
  873.  Dim l4 As Long 'l4 = Total Number Of Clusters
  874. sDrive = Left$(sPath, 1) & ":\" 'Get drive letter from path
  875. lReturn = GetDiskFreeSpace(sDrive, l1, l2, l3, l4)
  876. 'DiskSpace = l1 * l2 * l3
  877. dFree = l1 * l2 * l3
  878. dTotal = l1 * l2 * l4
  879. dUsed = dTotal - dFree
  880. End Function
  881. Public Sub PlayAudioCd(TrackNum As Integer, Optional StopPlaying As Boolean)
  882. On Local Error Resume Next
  883. Dim i As Long, RS As String, cb As Long, t#
  884. RS = Space$(128)
  885. If StopPlaying Then
  886. i = mciSendString("stop cdaudio", RS, 128, cb)
  887. i = mciSendString("close cdaudio", RS, 128, cb)
  888. Else
  889. i = mciSendString("stop cdaudio", RS, 128, cb)
  890. i = mciSendString("close cdaudio", RS, 128, cb)
  891. RS = Space$(128)
  892. i = mciSendString("status cdaudio position track " & TrackNum, RS, 128, cb)
  893. i = mciSendString("open cdaudio", RS, 128, cb)
  894. i = mciSendString("set cdaudio time format milliseconds", RS, 128, cb)
  895. i = mciSendString("play cdaudio", RS, 128, cb)
  896. End If
  897. End Sub
  898. Public Sub AutoRun(drv As AutoRunDrives)
  899. RegistryValueB "software\microsoft\windows\currentversion\policies\explorer", "NoDriveTypeAutoRun", CByte(drv), CURRENT_USER
  900. End Sub
  901. Public Function ComputerName(func As ComputerNames, Optional CmpName As String) As String
  902. Dim temp As String
  903. temp = Space$(255)
  904. Select Case func
  905.     Case 0
  906.         GetComputerName temp, 255
  907.         ComputerName = StripNulls(temp)
  908.     Case 1
  909.         If CmpName <> "" Then SetComputerName CmpName
  910.     Case 2
  911.         GetUserName temp, 255
  912.         ComputerName = StripNulls(temp)
  913. End Select
  914. End Function
  915. Public Function DiskVolumeInfo(sPath As String, sDriveName As String, lLength As Long, lSerialNo As Long, lMaximumChar As Long, lFileSystemFlags As Long, sNameOfFileSystem As String, lLeng As Long)
  916. t = GetVolumeInformation(sPath, sDriveName, lLength, lSerialNo, lMaximumChar, lFileSystemFlags, sNameOfFileSystem, lLeng)
  917. End Function
  918.  
  919. Public Function RegEnumKeys&(rgeSubKey As String, handleListbox As Long, rgeMainKey As Long)
  920.     Dim sRoot$, sRoot2$, temp As String
  921.          
  922.     ' --------------------------------------------------------
  923.     ' This function will load all subkeys into the TreeView
  924.     ' --------------------------------------------------------
  925.     Dim lRtn&       ' Returned by registry functions, should be 0&
  926.     Dim hKey&       ' Return handle to opened key
  927.     Dim strucLastWriteTime    As FILETIME
  928.     Dim sSubKeyName$
  929.     Dim sClassString$
  930.     Dim lLenSubKey&
  931.     Dim lLenClass&
  932.     Dim lKeyIndx&
  933.     Dim lRet&
  934.     Dim hKey2&
  935.     Dim sSubKey2$
  936.     Dim sNewKey$
  937.     
  938.     '---------------------------------------------
  939.     'values for QueryInfoKey:
  940.     '---------------------------------------------
  941.     Dim sClassName$
  942.     Dim lClassLen&
  943.     Dim lSubKeys&
  944.     Dim lMaxSubKey&
  945.     Dim sMaxSubKey$
  946.     Dim lMaxClass&
  947.     Dim sMaxClass$
  948.     Dim lValues&
  949.     Dim lMaxValueName&
  950.     Dim lMaxValueData&
  951.     Dim lSecurityDesc&
  952.     
  953.     ' -----------------------------------------------------
  954.     ' Open key
  955.     ' -----------------------------------------------------
  956.     lRtn = RegOpenKeyEx(rgeMainKey, rgeSubKey, 0&, KEY_READ, hKey)
  957.         
  958.     ' -----------------------------------------------------
  959.     ' A call to RegQueryInfoKey will tell us the maximum
  960.     '   keyname length
  961.     ' -----------------------------------------------------
  962.     sClassName = Space$(255)
  963.     lClassLen = CLng(Len(sClassName))
  964.     lRet = RegQueryInfoKey(hKey, sClassName, lClassLen, 0&, lSubKeys, lMaxSubKey, lMaxClass, lValues, lMaxValueName, lMaxValueData, lSecurityDesc, strucLastWriteTime)
  965.     sMaxSubKey = Space$(lMaxSubKey + 1)
  966.     sMaxClass = Space$(lMaxClass + 1)
  967.  
  968.     ' -----------------------------------------------------
  969.     ' Enumerate the keys
  970.     ' -----------------------------------------------------
  971.     lKeyIndx = 0&
  972.     Do While lRtn = ERROR_SUCCESS
  973.         
  974.         ' -----------------------------------------------------
  975.         ' If the enumeration fails due to a buffer over-run,
  976.         '   we will loop back to this point with larger buffers.
  977.         ' -----------------------------------------------------
  978. ReTryKeyEnumeration:
  979.             
  980.         ' --------------------------------------------------
  981.         ' Set variables
  982.         ' --------------------------------------------------
  983.         sSubKeyName = sMaxSubKey
  984.         lLenSubKey = lMaxSubKey
  985.         sClassString = sMaxClass
  986.         lLenClass = lMaxClass
  987.     
  988.         
  989.         ' --------------------------------------------------
  990.         ' Call the enumeration function
  991.         ' --------------------------------------------------
  992.         lRtn = RegEnumKeyEx(hKey, lKeyIndx, sSubKeyName, lLenSubKey, 0&, sClassString, lLenClass, strucLastWriteTime)
  993.         If InStr(sSubKeyName, Chr$(0)) > 1 Then
  994.             sSubKeyName = Left$(sSubKeyName, InStr(sSubKeyName, Chr$(0)) - 1)
  995.         End If
  996.         
  997.         
  998.         ' --------------------------------------------------
  999.         ' Check for success
  1000.         ' --------------------------------------------------
  1001.         If lRtn = ERROR_SUCCESS Then
  1002.             lNewKey = lNewKey + 1
  1003.             sNewKey = "A" & Format$(lNewKey, "000000")
  1004.                     temp = sSubKeyName
  1005.                     SendMessageList handleListbox, LB_ADDSTRING, -1, ByVal temp
  1006. '            If bFullEnumeration = True Then
  1007. '                sSubKey2 = sSubKeyName
  1008. '                If rgeSubKey <> "" Then
  1009. '                    sSubKey2 = Trim(rgeSubKey) & "\" & sSubKeyName
  1010. '                 End If
  1011. '
  1012. '                ' -----------------------------------------------
  1013. '                ' Use RegQueryInfoKey to find out if this key has
  1014. '                '   subkeys
  1015. '                ' -----------------------------------------------
  1016. '                lRet = RegOpenKeyEx(rgeMainKey, sSubKey2, 0&, KEY_READ, hKey2)
  1017. '                '------------------------------------------------------
  1018. '                'We are fully enumerating a key, so set images and
  1019. '                'Recurse a single SubKey to set + indicator if there are
  1020. '                'subkeys below this one
  1021. '                '------------------------------------------------------
  1022. '                lRet = RegQueryInfoKey(hKey2, vbNullString, 0&, 0&, lSubKeys, 0&, 0&, 0&, 0&, 0&, 0&, strucLastWriteTime)
  1023. '                    ' --------------------------------------------------
  1024. '                    ' Check for success.  If lSubKeys is greater than zero
  1025. '                    ' there are subkeys for this key, and we will set a fake
  1026. '                    ' node under this one to make a + symbol.
  1027. '                    ' --------------------------------------------------
  1028. '                    If lRet = ERROR_SUCCESS And lSubKeys > 0 Then
  1029. '                        sRoot2 = nodX.key
  1030. '                        lNewKey = lNewKey + 1
  1031. '                        sNewKey = "A" & Format$(lNewKey, "000000")
  1032. '                        Set nodX = Form1.TreeView1.Nodes.Add(sRoot2, tvwChild, sNewKey, "PlaceHolder", 1)
  1033. '                    End If
  1034. '                    lRet = RegCloseKey(hKey2)
  1035. '                End If
  1036. '            Else
  1037. '                Exit Do
  1038. '            End If
  1039.             lKeyIndx = lKeyIndx + 1
  1040.         ElseIf lRtn = ERROR_MORE_DATA Then
  1041.             ' -----------------------------------------------
  1042.             ' This error means that, despite querying the key
  1043.             '   we have not set one of the buffers large
  1044.             '   enough.Increment the buffer sizes and try
  1045.             '   again
  1046.             ' -----------------------------------------------
  1047.             lMaxSubKey = lMaxSubKey + 5
  1048.             lMaxClass = lMaxClass + 5
  1049.             sMaxSubKey = Space$(lMaxSubKey + 1)
  1050.             sMaxClass = Space$(lMaxClass + 1)
  1051.             GoTo ReTryKeyEnumeration
  1052.         ElseIf lRtn = ERROR_NO_MORE_ITEMS Then
  1053.             ' -----------------------------------------------
  1054.             ' Not an error, just end of list -- exit the
  1055.             '   loop
  1056.             ' -----------------------------------------------
  1057.             lRtn = ERROR_SUCCESS
  1058.             Exit Do
  1059.         ElseIf lRtn <> ERROR_SUCCESS Then
  1060.             ' --------------------------------------------------
  1061.             ' Key still open, so display the error and fall
  1062.             '   thru to the close function below
  1063.             ' --------------------------------------------------
  1064.             
  1065.             Exit Do
  1066.         End If
  1067.     Loop
  1068.  
  1069.     
  1070.     ' -----------------------------------------------------
  1071.     ' Ste Declar=(yEnumeration:
  1072.  x, LB_ADDSTRING, -1, ByVal temp
  1073. '            If bFullEnumeration = True Then
  1074. '               Ct,0.----------------------------- ShowCursor(p
  1075. '            If bFullEnumeration = True Then
  1076. '               Ct,0.---------------------y2)
  1077. '       -------------------------------------vR ---hen    -----------r     ----------t--------4 Loop
  1078.  
  1079.  
  1080.  
  1081.  
  1082.  
  1083.    -----vR------gKey + 5
  1084.       ---------gKey +ey + 5
  1085.       ---------gKey +ey + 5
  1086. '                'We are fu_mciSendString("stop cdaudio", RS,  l  lNewKey = l 5endSi.tri---hen    --- ---g---NewKey = l 5endSi.tre
  1087.  Oe     _= 6
  1088.     sney +NewKey = l
  1089.  Oe  i
  1090.  
  1091.  
  1092.  
  1093.  
  1094.  
  1095.    -----vR------lRet+ 5
  1096.    lmlMaxValueDa nod   O s
  1097.      End If
  1098. '5
  1099.    lmlMaxe--vR------gKeoN